unit magic;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,Graphics,
  magick_wand, ImageMagick, IntfGraphics, FPimage,
  LazUTF8, mywandfunc, registry,forms;

type

{ TMyMagic }

TMyMagic=class
private

  wand: PMagickWand;

  function GetImgIndex: integer;
  procedure SetImgIndex(AValue: integer);
  procedure ThrowWandException(aWand: PMagickWand);
  function GetImgCount:integer;
public
 property ImgCount:integer read GetImgCount;
 property ImgIndex:integer read GetImgIndex write SetImgIndex;

 constructor Create;
 destructor Destroy;override;

 procedure Clear;
 procedure LoadFromFile(fname:string);
 procedure SaveToFile(fname:string);
 procedure MakeThumbnails(w,h:integer);
 procedure GetCurrentImg(bmp:TBitmap);
 procedure PolyLine(clr:TColor;pw:integer;pcnt:integer;pnts :PPointInfo);
 procedure Rectangle(clr:TColor;x1,y1,x2,y2:integer);
 procedure CompressImages;

end;

procedure InitImageMagic;
procedure FreeImageMagic;

implementation

procedure WriteImageMagicRegistryKeys(r:TRegistry;keypath,magicdir:string);
begin
  if r.OpenKey(keypath,true) then
       begin
         r.WriteString('BinPath',magicdir);
         r.WriteString('CoderModulesPath',magicdir+'modules\coders');
         r.WriteString('ConfigurePath',magicdir);
         r.WriteString('FilterModulesPath',magicdir+'modules\filters');
         r.WriteString('LibPath',magicdir);
         r.WriteInteger('QuantumDepth',16);
         r.WriteString('Version','6.8.8');
         r.WriteString('PDFCorrector',magicdir);
         r.CloseKey;
       end;
end;
procedure WriteGhostscriptRegistryKeys(r:TRegistry;keypath,magicdir:string);
var libsdir:string;
begin
  keypath:=keypath+'9.10';
  if r.OpenKey(keypath,true) then
       begin
         libsdir:= magicdir+ 'gs\gs9.10\bin;'
                   +  magicdir+ 'gs\gs9.10\lib;'
                   +  magicdir+ 'gs\gs9.10\fonts';
         r.WriteString('GS_DLL',magicdir+'gs\gs9.10\bin\gsdll32.dll');
         r.WriteString('GS_LIB',libsdir);
         r.WriteString('PDFCorrector',magicdir);
         r.CloseKey;
       end;
end;

procedure InitImageMagic;
var r:TRegistry;
    buf:string ;
    fi,fg:boolean;
const MAGIC_KEYPATH='SOFTWARE\ImageMagick\';
      GHOST_KEYPATH='SOFTWARE\GPL Ghostscript\';
begin
   buf:= ExtractFilePath(Application.ExeName);
   r:=TRegistry.Create;
   try
     r.RootKey:= HKEY_LOCAL_MACHINE;
     fi:=not r.KeyExists(MAGIC_KEYPATH+'Current');
     fg:=not r.KeyExists(GHOST_KEYPATH);
     r.RootKey:= HKEY_CURRENT_USER;
     r.Access:=KEY_WRITE;
     if  fi  then
     begin
       WriteImageMagicRegistryKeys(r,MAGIC_KEYPATH+'Current',buf);
       WriteImageMagicRegistryKeys(r,MAGIC_KEYPATH+'6.8.8\Q:16',buf);
     end;
     if fg then
     begin
       WriteGhostscriptRegistryKeys(r,GHOST_KEYPATH,buf);
     end;
     MagickWandGenesis;
   finally
     r.free;
   end;
end;

procedure FreeImageMagic;
begin
   MagickWandTerminus;
end;

constructor TMyMagic.Create;
begin
  wand := NewMagickWand;
end;

destructor TMyMagic.Destroy;
begin
  DestroyMagickWand(wand);
end;

procedure TMyMagic.Clear;
begin
   ClearMagickWand(wand);
end;

procedure TMyMagic.LoadFromFile(fname:string);
var  status: MagickBooleanType;
     ci,ni:integer;
     new_wand,flat_wand:PMagickWand;
begin

    new_wand:=NewMagickWand;
    MagickSetResolution(new_wand,100.0,100.0);
    status := MagickReadImage(new_wand, PChar(fname));
    if (status = MagickFalse) then
      ThrowWandException(new_wand);

    ci:=MagickGetIteratorIndex(wand);

    if UpperCase(ExtractFileExt(fname)) = '.PDF' then
    begin
        ni:= MagickGetNumberImages(new_wand);
        while ( ni>0 ) do
        begin
            MagickSetLastIterator(new_wand);
            flat_wand:=MagickMergeImageLayers(new_wand,MergeLayer);
            MagickSetFirstIterator(new_wand);
            MagickAddImage(new_wand,flat_wand);
            DestroyMagickWand(flat_wand);
            MagickSetLastIterator(new_wand);
            MagickRemoveImage(new_wand);
            dec(ni);
        end;
    end;

    MagickSetLastIterator(wand);
    MagickAddImage(wand,new_wand);
    DestroyMagickWand(new_wand);

    if (ImgCount>0) and (ci<0) then
      ci:=0;
    if ci>=0 then
      MagickSetIteratorIndex(wand,ci);
end;

procedure TMyMagic.SaveToFile(fname:string);
var  status: MagickBooleanType;
begin
  CompressImages;
  status := MagickWriteImages(wand, PChar(fname), MagickTrue);
  if (status = MagickFalse) then ThrowWandException(wand);
end;
{ Turn the images into a thumbnail sequence. }
procedure TMyMagic.MakeThumbnails(w,h:integer);
begin
     MagickResetIterator(wand);
     while (MagickNextImage(wand) <> MagickFalse) do
     MagickResizeImage(wand, w, h, LanczosFilter, 1.0);
end;

procedure TMyMagic.ThrowWandException(aWand: PMagickWand);
var
  description: PChar;
  msg:string;
  severity: ExceptionType;
begin
  description := MagickGetException(aWand, @severity);
  msg:=Format('An error ocurred. Description: %s', [description]) ;
  description := MagickRelinquishMemory(description);
  raise Exception.Create(msg);
end;

function TMyMagic.GetImgIndex: integer;
begin
  Result:= MagickGetIteratorIndex(wand);
end;

procedure TMyMagic.SetImgIndex(AValue: integer);
begin
  MagickSetIteratorIndex(wand, AValue);
end;

function TMyMagic.GetImgCount:integer;
begin
  Result:=MagickGetNumberImages(wand) ;
end;

//-------------------------------------------------------------------
procedure TMyMagic.GetCurrentImg(bmp:TBitmap);
var
  img: Pimage;
  pack: PPixelPacket;
  limg: TLazIntfImage;
  i, j, wi, he: integer;
  colo: TFPColor;
begin
  img := GetImageFromMagickWand(wand);
  if not Assigned(img) then
  begin
      bmp.Clear;
      exit;
  end;
  he := MagickGetImageHeight(wand);
  wi := MagickGetImageWidth(wand);
  limg := TLazIntfImage.Create(0, 0);
  try
    limg.DataDescription := GetDescriptionFromDevice(0, wi, he);
    pack := GetAuthenticPixels(img, 0, 0, wi, he, nil);
    for j := 0 to he - 1 do
      for i := 0 to wi - 1 do
      begin
        colo.red := pack^.red;
        colo.green := pack^.green;
        colo.blue := pack^.blue;
        colo.alpha := pack^.opacity;
        limg.Colors[i, j] := colo;
        Inc(pack);
      end;
    Bmp.LoadFromIntfImage(limg);
  finally
    limg.Free;
  end;
end;

procedure TMyMagic.PolyLine(clr: TColor; pw: integer; pcnt: integer;
  pnts: PPointInfo);
var dr_wand: PDrawingWand;
    px_wand: PPixelWand;
    tc:TFPColor;
    pc:PixelPacket;

begin

  dr_wand:=NewDrawingWand;
  px_wand:=NewPixelWand;

  tc:=TColorToFPColor(clr);
  pc.red:=tc.red;
  pc.blue:=tc.blue;
  pc.green:=tc.green;
  pc.opacity:=0;

  DrawSetStrokeWidth(dr_wand,pw);
  DrawSetStrokeLineCap(dr_wand,RoundCap);
  DrawSetStrokeLineJoin(dr_wand,RoundJoin);

  PixelSetQuantumColor(px_wand,@pc);
  DrawSetStrokeColor(dr_wand,px_wand);

  PixelSetColor(px_wand,'none');
  DrawSetFillColor(dr_wand,px_wand);

  DrawPolyline(dr_wand,pcnt,pnts);
  MagickDrawImage(wand,dr_wand);

  DestroyDrawingWand(dr_wand);
  DestroyPixelWand(px_wand);

  //MagickCommentImage(wand,PChar('Corrected by PDFCorrector - http://pdfcorrector.5co.org'));

end;

procedure TMyMagic.Rectangle(clr: TColor; x1, y1, x2, y2: integer);
var dr_wand: PDrawingWand;
    px_wand: PPixelWand;
    tc:TFPColor;
    pc:PixelPacket;

begin

  dr_wand:=NewDrawingWand;
  px_wand:=NewPixelWand;

  tc:=TColorToFPColor(clr);
  pc.red:=tc.red;
  pc.blue:=tc.blue;
  pc.green:=tc.green;
  pc.opacity:=0;

  DrawSetStrokeWidth(dr_wand,1);
  PixelSetQuantumColor(px_wand,@pc);
  DrawSetStrokeColor(dr_wand,px_wand);
  DrawSetFillColor(dr_wand,px_wand);

  DrawRectangle(dr_wand,x1,y1,x2,y2);
  MagickDrawImage(wand,dr_wand);

  DestroyDrawingWand(dr_wand);
  DestroyPixelWand(px_wand);
end;

procedure TMyMagic.CompressImages;
var i,j:integer;
begin
  {
  if ImgCount>0 then
  begin
    i:=ImgIndex;
    for j:=0 to ImgCount-1 do
    begin
      ImgIndex:=j;

      MagickSetImageCompression(wand, JPEGCompression);
      MagickSetImageCompressionQuality(wand, 80);
      //MagickSetImageDepth(wand,8)

    end;
    ImgIndex:=i;
  end;
   }
end;

end.

